Dans le cadre de la création du langage de marquage MarkIt, il était indispensable pour moi de générer des documents aléatoires afin de tester toutes les fonctionnalités du programme et de vérifier la mise en page.
Il était donc nécessaire de créer un générateur prenant en compte les spécificités de du langage et éviter les incohérences de structure du document:
Limitation de la profondeur des listes
Pas d'en-têtes dans les listes, les tableaux, les notes, …
…
La bibliothèque quickcheck
permet bien de générer des valeurs aléatoires avec différents modificateurs mais pas de modifier l'état des générateurs en cours de fonctionnement.
Pour pouvoir le faire, il faut donc passer par une bibliothèque gérant les états (transformers
par exemple) et plus particulièrement le modificateur StateT
qui permet de créer une monade state "modifiée" contenant une monade d'un autre type.
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import Test.QuickCheck
import Test.QuickCheck.Gen
Supposons que l'on veuille générer des structures de données avec le type suivant en limitant la profondeur, en forçant le premier élément à être un en-tête et avec des générateurs spécifiques à chaque niveau de profondeur.
data MyElem = Header String
| Upper [MyElem]
| Str [String]
| Tag String
deriving(Show)
Il nous faut donc un état qui contiendra les différents paramètres permettant de modifier les générateurs en cours d'exécution:
data MyState = MyState
{ lastHeader :: Maybe String -- ^ The title of the last header (If a header is passed).
, level :: Int -- ^ The level (depth) where we are in the structure.
, usedTags :: [String] -- ^ The list of laready used tags.
}
initState = MyState
{ lastHeader = Nothing
, level = 1
, usedTags = []
}
On utilise le type StateT
pour modifier et créer un nouveau monad embarquant l'état MyState
et permettant de faire tournant des monads Gen
(provenant de la bibliothèque quickcheck
) à l'intérieur.
type MyGen t = StateT MyState Gen t
Le lancement des fonctions de générations à l'intérieur de la monade MyGen
se fait à l'aide de la fonction lift
genUpper :: MyGen MyElem
genUpper = do
modify (\st -> st { level = level st + 1 })
es <- genBase
modify (\st -> st { level = level st - 1 })
return $ Upper es
genElems :: MyGen [MyElem]
genElems = do
l <- gets level
if l == 1
then vectorOfM 6 $ oneofM [genStr, genHeader, genUpper, genTag]
else if l > 4 -- Limit the depth to 4
then vectorOfM 3 $ oneofM [genStr, genTag]
else vectorOfM 4 $ oneofM [genStr, genUpper, genTag]
genStr :: MyGen MyElem
genStr = do
l <- gets level
v <- lift $ case l of -- Set the maximum string length according to the level of the structure.
1 -> choose (5, 10)
2 -> choose (3, 7)
_ -> choose (1, 5)
s <- lift $ vectorOf v $ elements ["Lorem", "Ispum", "Dolor", "Sit", "Amet", "Elit", "Duis", "Sagittis", "Tortor"]
return $ Str s
genHeader :: MyGen MyElem
genHeader = do
h <- lift $ elements ["A header", "Another header", "Still another header", "No more header"]
modify (\st -> st { lastHeader = Just h })
return $ Header h
genTag :: MyGen MyElem
genTag = do
tgs <- gets usedTags
let tag = head $ filter (`notElem` tgs) $ map (\i -> "TAG" ++ show i) [1 ..]
modify (\st -> st { usedTags = tag : usedTags st }) -- Set the already used tags
return $ Tag tag
genBase = do
stat <- get
case lastHeader stat of
Nothing -> do -- Force the first element to be a Header.
e <- genHeader
es <- genBase
return $ e : es
Just _ -> do
genElems
Il sera nécessaire de faire des versions spécifiques de certaines fonctions (transformers) de la librairie quickcheck
pour pouvoir les utiliser avec la nouvelle monade MyGen
. Il faudra réécrire les fonctions décrites dans le module Test.QuickCheck.Gen.
vectorOfM :: Int -> MyGen t -> MyGen [t]
vectorOfM = replicateM
oneofM :: [MyGen t] -> MyGen t
oneofM [] = error "oneofM used with empty list"
oneofM gs = do
v <- lift $ choose (0, length gs - 1)
gs !! v
Une fois ce travail fait, on peut générer des strcutures aléatoires en combinant les fonctions generate
du module quickcheck
et evalStateT
du module
main = do
struct <- generate $ evalStateT genBase initState
print struct
et on peut générer les structures souhaitées:
[ Header "No more header"
, Tag "TAG1"
, Tag "TAG2"
, Header "A header"
, Str ["Dolor", "Sit", "Dolor", "Elit", "Lorem", "Amet", "Ispum"]
, Header "Another header"
, Header "No more header"
]
[ Header "Still another header"
, Str
[ "Dolor"
, "Sagittis"
, "Amet"
, "Sagittis"
, "Sagittis"
, "Duis"
, "Duis"
, "Duis"
, "Lorem"
, "Tortor"
]
, Header "Another header"
, Header "Another header"
, Upper
[ Upper
[ Str ["Tortor", "Duis", "Tortor"]
, Str ["Duis", "Amet", "Tortor", "Amet"]
, Upper
[ Upper
[ Str ["Lorem", "Sit", "Tortor", "Tortor"]
, Str ["Elit", "Lorem", "Duis", "Sagittis", "Amet"]
, Tag "TAG1"
]
, Upper
[ Tag "TAG2"
, Tag "TAG3"
, Str ["Lorem", "Duis", "Ispum", "Duis", "Elit"]
]
, Str ["Elit", "Duis", "Lorem", "Amet"]
, Upper
[ Str ["Sagittis", "Sagittis", "Dolor", "Tortor", "Sit"]
, Tag "TAG4"
, Tag "TAG5"
]
]
, Str ["Amet"]
]
, Tag "TAG6"
, Upper
[ Upper
[ Str ["Ispum", "Sit"]
, Upper [Str ["Lorem"], Str ["Duis", "Sit"], Tag "TAG7"]
, Tag "TAG8"
, Tag "TAG9"
]
, Upper
[ Str ["Sit", "Lorem", "Dolor", "Sagittis", "Sagittis"]
, Tag "TAG10"
, Str ["Tortor", "Ispum", "Duis", "Elit"]
, Tag "TAG11"
]
, Str ["Duis", "Duis", "Amet", "Tortor", "Lorem"]
, Upper
[ Tag "TAG12"
, Tag "TAG13"
, Upper
[ Str ["Sagittis", "Tortor", "Elit", "Dolor"]
, Str ["Ispum", "Duis", "Sit"]
, Tag "TAG14"
]
, Str ["Elit", "Lorem", "Sagittis"]
]
]
, Tag "TAG15"
]
, Header "No more header"
, Header "A header"
]